home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_VID / BUTTHD.ZIP;1 / SAVER.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-10-06  |  3.2 KB  |  143 lines
  1. Unit Saver;
  2.  
  3. interface
  4.  
  5. uses WinProcs, WinTypes, Objects, OMemory, OWindows, ODialogs;
  6. const
  7.   sc_ScreenSave = $F140;
  8. type
  9.  
  10.   PConfigDialog = PWindowsObject;
  11.  
  12.   PSApplication = ^TApplication;
  13.   TSApplication = object(TApplication)
  14.     Configure: Boolean;
  15.     procedure MessageLoop; virtual;
  16.     procedure Idle; virtual;
  17.   end;
  18.  
  19.   PScrnSavWindow = ^TScrnSavWindow;
  20.   TScrnSavWindow = Object(TWindow)
  21.     BackGroundColor: integer;
  22.     First:Boolean;
  23.     prevPt:TPoint;
  24.     PCfgDialog : PConfigDialog;
  25.     constructor Init(aParent:PWindowsObject; aTitle:PChar);
  26.     destructor Done;virtual;
  27.     function GetClassName: PChar; virtual;
  28.     procedure GetWindowClass(var aWndClass: TWndClass); virtual;
  29.     procedure SetupWindow; virtual;
  30.     procedure DefWndProc(var Msg: TMessage); virtual;
  31.     procedure WMSyscommand(var Msg: TMessage); virtual WM_SysCommand;
  32.     procedure Animate; virtual;
  33.   end;
  34.  
  35. implementation
  36.  
  37. procedure TSApplication.MessageLoop;
  38. var
  39.   Message: TMsg;
  40. begin
  41.   while True do
  42.   begin
  43.     if PeekMessage(Message, 0, 0, 0, pm_Remove) then
  44.     begin
  45.       if Message.Message = wm_Quit then
  46.       begin
  47.         Status := Message.WParam;
  48.         Exit;
  49.       end;
  50.       if not ProcessAppMsg(Message) then
  51.       begin
  52.         TranslateMessage(Message);
  53.         DispatchMessage(Message);
  54.       end;
  55.     end
  56.     else
  57.       Idle;
  58.   end;
  59. end;
  60.  
  61. procedure TSApplication.Idle;
  62. begin
  63.   if (Configure = false) and (MainWindow <> nil) then
  64.     PScrnSavWindow(MainWindow)^.Animate;
  65. end;
  66.  
  67. constructor TScrnSavWindow.Init(aParent: PWindowsObject; aTitle: PChar);
  68. begin
  69.   TWindow.Init(aParent, aTitle);
  70.   First := True;
  71.   ShowCursor(False);
  72.   Attr.Style  := WS_POPUP;
  73. end;
  74.  
  75. destructor TScrnSavWindow.Done;
  76. begin
  77.   ShowCursor(True);
  78.   TWindow.Done;
  79. end;
  80.  
  81. function TScrnSavWindow.GetClassName: PChar;
  82. begin
  83.   GetClassName := 'ScreenSaverClass';
  84. end;
  85.  
  86. procedure TScrnSavWindow.GetWindowClass(var aWndClass:TWndClass);
  87. begin
  88.   TWindow.GetWindowClass(aWndClass);
  89.   aWndClass.hIcon := 0 ;
  90.   aWndClass.Style := cs_SaveBits;
  91.   aWndClass.hbrBackground := GetStockObject(BackGroundColor);
  92. end;
  93.  
  94. procedure TScrnSavWindow.SetupWindow;
  95. var
  96.   rc: TRect;
  97. begin
  98.   TWindow.SetupWindow;
  99.   GetCursorPos(PrevPt);
  100.   GetWindowRect(GetDesktopWindow, rc);
  101.   MoveWindow(hWindow, rc.Left, rc.Top, rc.Right, rc.Bottom,True);
  102. end;
  103.  
  104. procedure TScrnSavWindow.DefWndProc(Var Msg:TMessage);
  105. begin
  106.   case  msg.Message  of
  107.     WM_MOUSEMOVE:
  108.       if (MAKEPOINT(msg.LParam).x <> prevPt.x) or
  109.          (MAKEPOINT(msg.LParam).y <> prevPt.y) then
  110.         if Not First then
  111.           PostMessage(HWindow, WM_CLOSE, 0, 0)
  112.         else
  113.           First := False;
  114.     WM_ACTIVATE,
  115.     WM_ACTIVATEAPP:
  116.       if ( msg.WParam = 0 ) then
  117.       begin
  118.         TWindow.DefWndProc(Msg);
  119.         exit;
  120.       end;
  121.     WM_KEYDOWN,
  122.     WM_SYSKEYDOWN,
  123.     WM_LBUTTONDOWN,
  124.     WM_MBUTTONDOWN,
  125.     WM_RBUTTONDOWN: PostMessage(HWindow, WM_CLOSE, 0, 0);
  126.   end;
  127.   TWindow.DefWndProc(Msg);
  128. end;
  129.  
  130. procedure TScrnSavWindow.WMSyscommand(var Msg: TMessage);
  131. begin
  132.   if ((Msg.WParam and $FFF0) = SC_ScreenSave) then
  133.     Msg.Result := 1
  134.   else
  135.     DefWndProc(Msg);
  136. end;
  137.  
  138. procedure TScrnSavWindow.Animate;
  139. begin
  140. end;
  141.  
  142.  
  143. end.